VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form ExportData 
   Caption         =   "Export Data"
   ClientHeight    =   3030
   ClientLeft      =   120
   ClientTop       =   450
   ClientWidth     =   4560
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   10950
   ScaleWidth      =   20160
   WindowState     =   2  'Maximized
   Begin VB.PictureBox picAdd 
      Appearance      =   0  'Flat
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   615
      Left            =   14640
      Picture         =   "Export.frx":0000
      ScaleHeight     =   615
      ScaleWidth      =   2055
      TabIndex        =   16
      Top             =   3840
      Width           =   2055
   End
   Begin VB.Frame Frame3 
      Caption         =   "Add Bonds"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3495
      Left            =   12960
      TabIndex        =   14
      Top             =   1320
      Width           =   5535
      Begin VB.CommandButton Command1 
         Caption         =   "Add To City"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   1080
         TabIndex        =   15
         Top             =   1080
         Width           =   3255
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "Export Policy Details"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3495
      Left            =   6960
      TabIndex        =   6
      Top             =   1320
      Width           =   5535
      Begin VB.PictureBox picProcess 
         Appearance      =   0  'Flat
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   615
         Left            =   480
         Picture         =   "Export.frx":0369
         ScaleHeight     =   615
         ScaleWidth      =   2055
         TabIndex        =   12
         Top             =   2520
         Width           =   2055
      End
      Begin VB.CommandButton btnExpPol 
         Caption         =   "Export Data"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   2640
         TabIndex        =   7
         Top             =   2520
         Width           =   1455
      End
      Begin MSComCtl2.DTPicker dtPolTo 
         Height          =   375
         Left            =   2640
         TabIndex        =   8
         Top             =   1560
         Width           =   1455
         _ExtentX        =   2566
         _ExtentY        =   661
         _Version        =   393216
         Format          =   99221505
         CurrentDate     =   40600
      End
      Begin MSComCtl2.DTPicker dtPolFrom 
         Height          =   375
         Left            =   2640
         TabIndex        =   9
         Top             =   480
         Width           =   1455
         _ExtentX        =   2566
         _ExtentY        =   661
         _Version        =   393216
         Format          =   99221505
         CurrentDate     =   40600
      End
      Begin VB.Label Label4 
         Caption         =   "From"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   960
         TabIndex        =   11
         Top             =   480
         Width           =   1215
      End
      Begin VB.Label Label3 
         Caption         =   "To"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   960
         TabIndex        =   10
         Top             =   1680
         Width           =   975
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Export Employee Details"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3495
      Left            =   1080
      TabIndex        =   0
      Top             =   1320
      Width           =   5535
      Begin VB.PictureBox picProcessEmp 
         Appearance      =   0  'Flat
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   615
         Left            =   360
         Picture         =   "Export.frx":06D2
         ScaleHeight     =   615
         ScaleWidth      =   2055
         TabIndex        =   13
         Top             =   2520
         Width           =   2055
      End
      Begin VB.CommandButton btnExEmp 
         Caption         =   "Export Data"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   2640
         TabIndex        =   1
         Top             =   2520
         Width           =   1455
      End
      Begin MSComCtl2.DTPicker dtpTo 
         Height          =   375
         Left            =   2640
         TabIndex        =   2
         Top             =   1560
         Width           =   1455
         _ExtentX        =   2566
         _ExtentY        =   661
         _Version        =   393216
         Format          =   99221505
         CurrentDate     =   40600
      End
      Begin MSComCtl2.DTPicker dtpFrom 
         Height          =   375
         Left            =   2640
         TabIndex        =   3
         Top             =   480
         Width           =   1455
         _ExtentX        =   2566
         _ExtentY        =   661
         _Version        =   393216
         Format          =   99221505
         CurrentDate     =   40600
      End
      Begin VB.Label Label1 
         Caption         =   "From"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   960
         TabIndex        =   5
         Top             =   480
         Width           =   1215
      End
      Begin VB.Label Label2 
         Caption         =   "To"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   960
         TabIndex        =   4
         Top             =   1680
         Width           =   975
      End
   End
   Begin MSAdodcLib.Adodc Adodc1 
      Height          =   330
      Left            =   2400
      Top             =   4200
      Width           =   1935
      _ExtentX        =   3413
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
End
Attribute VB_Name = "ExportData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Connection
Dim rs As Recordset
Dim fieldName As String
Dim dbc As Connection
Dim rcs As Recordset
'Dim recSet As Recordset
Dim oExcel, oBook As Object
Dim recSet As Recordset
Dim strCon As ADODB.Connection

Private Sub Command1_Click()
picAdd.Visible = True
Set strCon = GetExcelConnection(App.Path & "/ExportFiles/Bond.xls")
Set db = New Connection
db.Provider = "Microsoft.Jet.OLEDB.4.0;"
db.Open App.Path & "/Jeevan.mdb"
Set rs = New Recordset
rs.CursorLocation = adUseServer
rs.CursorType = adOpenKeyset
rs.LockType = adLockOptimistic
Set recSet = New Recordset
recSet.CursorLocation = adUseServer
recSet.CursorType = adOpenKeyset
recSet.LockType = adLockOptimistic
rs.Open "Select * from [Sheet1$]", strCon
MsgBox ("Total Bonds : " & rs.RecordCount)
rs.MoveFirst
While Not rs.EOF
recSet.Open "Select * from Customer where JVM='" & rs.Fields(0) & "'", db
If recSet.RecordCount = 0 Then MsgBox ("Bond Number Not Available : " & rs.Fields(0))
recSet.Close
recSet.Open "Update Customer Set Branch='JVM' where JVM='" & rs.Fields(0) & "'", db
'recSet.Close
rs.MoveNext
Wend
rs.Close
MsgBox ("Updated Successfully")
picAdd.Visible = False
End Sub

Private Function GetExcelConnection(ByVal Path As String, _
    Optional ByVal Headers As Boolean = False) As Connection
    Dim strConn As String
    Dim objConn As ADODB.Connection
    Set objConn = New ADODB.Connection
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & Path & ";" & _
              "Extended Properties=""Excel 12.0 Xml;HDR=" & _
              IIf(Headers, "Yes", "No") & """"
    objConn.Open strConn
    Set GetExcelConnection = objConn
End Function

Private Sub btnExEmp_Click()
picProcessEmp.Visible = True
openRecord
Set oExcel = CreateObject("EXCEL.Application")
Set oBook = oExcel.Workbooks.Add
rs.Open "Select * from AgentInfo where DOJ BETWEEN " & Format(dtpFrom.Value, "\#m\/d\/yyyy\#") & " AND " & Format(dtpTo.Value + 1, "\#m\/d\/yyyy\#"), db
If rs.RecordCount > 0 Then
result = generateExcel(1, "AgentInfo", rs)
rs.Close
If result Then saveFile ("Employee")
Else
MsgBox "No Records Found"
End If
picProcessEmp.Visible = False
End Sub

Private Sub btnExpPol_Click()
Dim qString As String
Dim tableAName(3) As String
Dim tableCName(3) As String
Dim sheetNo As Integer
'Plan A database tables
tableAName(0) = "PlanAMly"
tableAName(1) = "PlanAQly"
tableAName(2) = "PlanAHly"
tableAName(3) = "PlanAYly"
'Plan C database tables
tableCName(0) = "PlanCMly"
tableCName(1) = "PlanCQly"
tableCName(2) = "PlanCHly"
tableCName(3) = "PlanCYly"
'Sheet Number Initialization
sheetNo = 1
picProcess.Visible = True
openRecord
rs.Open "Select JVM from Customer where Branch <> NULL", db
i = 1
qString = ""
While Not rs.EOF
If rs.RecordCount > i Then
qString = qString & "'" & rs!JVM & "',"
Else
qString = qString & "'" & rs!JVM & "'"
End If
i = i + 1
rs.MoveNext
Wend
rs.Close
newConnection ("PlanA")
Set oExcel = CreateObject("EXCEL.Application")
Set oBook = oExcel.Workbooks.Add
rs.Open "Select * from Customer where DateCom BETWEEN " & Format(dtPolFrom.Value, "\#m\/d\/yyyy\#") & " AND " & Format(dtPolTo.Value + 1, "\#m\/d\/yyyy\#"), db
If rs.RecordCount > 0 Then
result = generateExcel(sheetNo, "Customer", rs)
sheetNo = sheetNo + 1
End If
For i = 0 To 3
rcs.Open "Select * from " & tableAName(i) & " where JVM IN (" & qString & ")", dbc
If (rcs.RecordCount > 0) Then
result = generateExcel(sheetNo, tableAName(i), rcs)
sheetNo = sheetNo + 1
End If
rcs.Close
Next
newConnection ("PlanC")
For i = 0 To 3
rcs.Open "Select * from " & tableCName(i) & " where JVM IN (" & qString & ")", dbc
If (rcs.RecordCount > 0) Then
result = generateExcel(i + 2, tableCName(i), rcs)
sheetNo = sheetNo + 1
End If
rcs.Close
Next
If result Then saveFile ("Customer")
picProcess.Visible = False
End Sub

Private Sub Form_Load()
picProcessEmp.Visible = False
picProcess.Visible = False
picAdd.Visible = False
Set db = New Connection
db.Provider = "Microsoft.Jet.OLEDB.4.0"
db.Open App.Path & "/Jeevan.mdb"
dtpFrom.Value = Now
dtPolFrom.Value = Now
dtPolTo.Value = Now
dtpTo.Value = Now
'commonDatabase
End Sub

Private Function openRecord()
Set rs = New Recordset
rs.LockType = adLockOptimistic
rs.CursorLocation = adUseServer
rs.CursorType = adOpenKeyset
End Function

Private Function generateExcel(sheetNo As Integer, sheetName As String, recSet As Recordset) As Boolean
If sheetNo > 3 Then
Set oSheet = oBook.Worksheets.Add
Else
Set oSheet = oBook.Worksheets(sheetNo)
End If
oSheet.Name = sheetName
recSet.MoveFirst
oSheet.Range("A1").CopyFromRecordset recSet
generateExcel = True
End Function

Private Function newConnection(dbName As String)
Set dbc = New Connection
dbc.Provider = "Microsoft.Jet.OLEDB.4.0"
dbc.Open App.Path & "/" & dbName & ".mdb"
Set rcs = New Recordset
rcs.LockType = adLockOptimistic
rcs.CursorLocation = adUseServer
rcs.CursorType = adOpenKeyset
End Function

Private Function commonDatabase()
Set recSet = New Recordset
recSet.LockType = adLockOptimistic
recSet.CursorLocation = adUseServer
recSet.CursorType = adOpenKeyset
End Function

Private Function saveFile(fileName As String)
If Dir(App.Path & "\ExportFiles", vbDirectory) <> "ExportFiles" Then MkDir (App.Path & "\ExportFiles")
oExcel.DisplayAlerts = False
oBook.SaveAs App.Path & "\ExportFiles\" & fileName & Format(DateTime.Date, "dd-mm-yyyy") & ".xls"
oExcel.Quit
MsgBox "Report Generated Successfully"
End Function
